home *** CD-ROM | disk | FTP | other *** search
/ Archive Magazine CD 1995 / Archive Magazine CD 1995.iso / discs / prog_disc / volume_8 / issue_02 / adv_basic / !ImpDemo / !RunImage (.txt) < prev    next >
Encoding:
RISC OS BBC BASIC V Source  |  1994-09-20  |  11.4 KB  |  361 lines
  1.            >!RunImage
  2.  Program   Test Program For ImpulseII
  3. DefineConstants
  4. InitApp
  5. Impulse_Init("<ImpDemo$Dir>.")
  6. Impulse_DefineMethods
  7.  quit%:
  8.  start of poll loop                         
  9.  "Wimp_Poll", 1, bk% 
  10.  reason%
  11.  "Impulse_Decode", reason%, bk%, , , , IMPULSE_METHOD_TABLE, TASK_ID% 
  12.  reason%, , , , , token,params,object
  13.  reason% 
  14. !    
  15.  "Wimp_OpenWindow",,bk%
  16. "    
  17.  "Wimp_CloseWindow",,bk%
  18. button
  19. menuselect
  20.  17,18:
  21. message
  22.  IMPULSE_COMMAND,IMPULSE_REQUEST:
  23.  )    
  24. command( token, params, object )
  25.  "Wimp_CloseDown"
  26. command(token,params,object)
  27.  token 
  28.  G_Token_OpenWin%  :
  29.       !bk% = mainw%
  30. 1)      
  31.  "Wimp_GetWindowState", , bk%
  32.       bk%!28 = -1
  33. 3%      
  34.  "Wimp_OpenWindow", , bk%
  35.  G_Token_CloseWin% :
  36.       !bk% = mainw%
  37. 8&      
  38.  "Wimp_CloseWindow", , bk%
  39.  G_Token_S1_On%    :
  40. <(      
  41. shell_IconSelect( mainw%, 9 )
  42.  G_Token_S2_On%    :
  43. @)      
  44. shell_IconSelect( mainw%, 10 )
  45.  G_Token_S1_Off%   :
  46. D*      
  47. shell_IconDeselect( mainw%, 9 )
  48.  G_Token_S2_Off%    :
  49. H+      
  50. shell_IconDeselect( mainw%, 10 )
  51. Update_MainWindow( token, params, object )
  52. Update_MainWindow( token, params, object )
  53. shell_IconPutData( mainw%, 3, 
  54. ( token ), 
  55. shell_IconPutData( mainw%, 1, $params, 
  56. shell_IconPutData( mainw%, 5, $object, 
  57. shell_IconPutData( mainw%, 7, "&" + 
  58. ~reason%, 
  59. button
  60.  bk%!8 
  61.  Read button state
  62.  bk%!12 = -2 
  63. e4     
  64.  If Menu pressed over iconbar, create menu
  65. f6     
  66.  "Wimp_CreateMenu", , menu%, !bk% - 64, 184
  67.  bk%!12 
  68.      
  69. n,       
  70.  <SELECT> used on iconbar icon..
  71.        !bk% = mainw%
  72. p*       
  73.  "Wimp_GetWindowState", , bk%
  74.        bk%!28 = -1
  75. r&       
  76.  "Wimp_OpenWindow", , bk%
  77. menuselect
  78.  button%
  79.  "Wimp_GetPointerInfo", , bk% + 256
  80.  read button state
  81. button% = bk%!264
  82.  !bk% 
  83.  quit if item 1 chosen
  84.    quit% = 
  85.  re-open menu if Adjust was  pressed
  86.  button% = 1 
  87.  "Wimp_CreateMenu", , menu%
  88. message
  89.  bk%!16 
  90. )                                     
  91.    quit%=
  92. string(a%)                        
  93.  convert a null-terminated string into CR-terminated
  94.  ?a%<>0
  95.  a$+=
  96. ?a%:a%+=1
  97. InitApp
  98.  bk% 2000,menu% 75,ind% 3000,name% 11
  99. quit% = 0
  100. TASK_NAME$ = "ImpDemo"
  101. err% = 0
  102.  "OS_ReadVarVal", TASK_NAME$ + "$Dir",bk%,255,0,3 
  103.  ,,i%
  104. bk%?i%=13:dir$=$bk%
  105.  "Wimp_Initialise", 200, &4B534154, TASK_NAME$ 
  106.  , ,TASK_ID%
  107. error:
  108.  "Wimp_OpenTemplate", , dir$ + ".Templates"
  109. i% = ind%
  110. 'infohan% = 
  111. CreateWindow("InfoBox")
  112. %mainw%   = 
  113. CreateWindow("mainw")
  114.  "Wimp_CloseTemplate"
  115. %!bk%=-1:bk%!4=0:bk%!8=0:bk%!12=68
  116. /bk%!16=68:bk%!20=&3002:$(bk%+24)="!ImpDemo"
  117.  "Wimp_CreateIcon",,bk%
  118. setupmenu(menu%)
  119. +buff% = 
  120. _heap_get(256):
  121.  text buffer..
  122. DefineConstants
  123. setupmenu(m%)
  124.  $m%,num%:len%=
  125. ($m%)-2
  126. !m%!12=&70207:m%!20=44:m%!24=0
  127. m%+=28:
  128.  i%=1 
  129.  num%
  130.  !m%=-&80*(i%=num%):
  131.  m%!4
  132. # m%!8=&7009021:
  133.  a$:$(m%+12)=a$
  134. a$>len% len%=
  135.  m%+=24
  136. :menu%!16=16*(len%+1)
  137. CreateWindow(template_name$)
  138.  window_handle%
  139.  "Wimp_LoadTemplate", , bk%, i%, ind% + 3000, -1, template_name$, 0 
  140.  ,,i%
  141.  "Wimp_CreateWindow", , bk% 
  142.  window_handle%
  143. = window_handle%
  144. error
  145. report(
  146. $ + " - internal error code "+
  147.  "Wimp_CloseDown"
  148. report(error_message$, error_box_flags%)
  149.  error_nr%
  150. error_nr% = 1
  151. !bk% = error_nr%
  152. &$(bk% + 4) = error_message$ + 
  153.  "Wimp_ReportError", bk%, error_box_flags%, TASK_NAME$
  154.  Data for iconbar menu
  155.  ImpDemo,2,infohan%,Info,-1,Quit
  156. Impulse_DefineMethods
  157. Impulse_MakeMethod( 0, G_Token_OpenWin% , "OpenWin" , "" )
  158. Impulse_MakeMethod( 0, G_Token_CloseWin%, "CloseWin", "" )
  159. Impulse_MakeMethod( 0, G_Token_S1_On%, "S1_On", "" )
  160. Impulse_MakeMethod( 0, G_Token_S2_On%, "S2_On", "" )
  161. Impulse_MakeMethod( 0, G_Token_S1_Off%, "S1_Off", "" )
  162. Impulse_MakeMethod( 0, G_Token_S2_Off%, "S2_Off", "" )
  163. shell_ImpulseWindupMethods
  164.  -----------------------------------------------------------------------
  165.  Memory Management Routines
  166.  -----------------------------------------------------------------------
  167. _heap_get(size%)
  168.  ptr%,heap%,flags%
  169.  Returns pointer to new memory block unless claim fails
  170.  in which case -1 is returned
  171.  First find start address of RMA..
  172.  "OS_ReadDynamicArea",1 
  173.  heap%
  174.  Now claim memory, trapping errors by using X form of SWI..
  175.  "XOS_Module",6,,,size% 
  176.  ,,ptr%;flags%
  177.  If error occured return -1, else return address of allocated
  178.  block
  179.  (flags% 
  180.  ptr% = -1
  181. = ptr%
  182. _heap_release(
  183.  ptr%)
  184.  maxfree%,nrpages%,flags%
  185.  Returns  0 if block released OK
  186.  Returns -1 if operation failed (i.e. block doesn't exist)
  187.  "XOS_Module",7,,ptr% 
  188.  ;flags%:
  189.  Free the block
  190.  (flags% 
  191.  1) = 0 
  192.  Block was released successfully...
  193.   ptr% = 0
  194.  Error occured trying to free the block, return -1 to signal to the
  195.  program that something went wrong (normally the program would ignore
  196.  this anyway)
  197.   ptr% = -1
  198.  -----------------------------------------------------------------------
  199.  Icon Handling Routines
  200.  -----------------------------------------------------------------------
  201. shell_IconSelect(WindowHandle%,IconHandle%)
  202. shell_IconSetState(WindowHandle%,IconHandle%,&200000,&200000)
  203. shell_IconDeselect(WindowHandle%,IconHandle%)
  204. shell_IconSetState(WindowHandle%,IconHandle%,0,&200000)
  205. shell_IconSetState(WindowHandle%,IconHandle%,EorWord%,ClearWord%)
  206.  icon_blk%
  207. M!icon_blk%  = 
  208. _heap_get( 16 )
  209. !icon_blk% = WindowHandle%
  210. icon_blk%!04 = IconHandle%
  211. icon_blk%!08 = EorWord%
  212. icon_blk%!12 = ClearWord%
  213.  "Wimp_SetIconState", , icon_blk%
  214. _heap_release( icon_blk% )
  215. shell_IconGetData(whandle%,ihandle%)
  216.  result$,icon_blk%
  217. icon_blk% = 
  218. _heap_get(40)
  219. icon_blk%!0 = whandle%
  220. icon_blk%!4 = ihandle%
  221.  "Wimp_GetIconState",,icon_blk%
  222.  (icon_blk%!24 
  223.  (1<<8))<>0 
  224.  result$=$(icon_blk%!28) 
  225.  result$=$(icon_blk%+28)
  226. _heap_release(icon_blk%)
  227. =result$
  228. shell_IconPutData(whandle%,ihandle%,data$,redraw)
  229.  blk%,old_str$
  230. j4old_str$ = 
  231. shell_IconGetData(whandle%,ihandle%)
  232.  data$ <> old_str$ 
  233.   blk%=
  234. _heap_get(40)
  235.   blk%!0 = whandle%
  236.   blk%!4 = ihandle%
  237.  "Wimp_GetIconState",,blk%
  238.  (blk%!24 
  239.  (1<<8)) <> 0 
  240.     $(blk%!28) = data$
  241. y!    $(blk% + 28) = 
  242. data$,11)
  243.  redraw <> 0 
  244.     blk%!8  = 0
  245.     blk%!12 = 0
  246. $    
  247.  "Wimp_SetIconState",,blk%
  248. _heap_release(blk%)
  249.  -----------------------------------------------------------------------
  250.  ImpulseII Handling Routines
  251.  -----------------------------------------------------------------------
  252. Impulse_Init(Root$)
  253. ( "RMEnsure Impulse 0.18 *RMLoad " + Root$ + "ImpulseII" )
  254.  "Impulse_Initialise", 18, TASK_ID%, TASK_NAME$, -1
  255. IMPULSE_TABLE_SIZE  = &400
  256.  IMPULSE_METHOD_TABLE IMPULSE_TABLE_SIZE
  257. 6G_Impulse_NextMethod%   = IMPULSE_METHOD_TABLE + 4
  258. IMPULSE_METHOD_TABLE!0  = 0
  259. G_Impulse_NextToken%    = 1
  260. G_Impulse_TxTag%        = 0
  261. G_Impulse_TxInProgress% = 
  262. G_Impulse_TxTop%        = 0
  263. G_Impulse_TxPtr%        = 0
  264.  Global Constants
  265. IMPULSE_COMMAND     = &200
  266. IMPULSE_REQUEST     = &201
  267. IMPULSE_REPLY       = &202
  268. IMPULSE_SENDDATA    = &203
  269. IMPULSE_RECEIVEDATA = &204
  270. Impulse_MakeMethod( Flags%, 
  271.  Token%, Method$, Syntax$ )
  272. .Token%              = G_Impulse_NextToken%
  273. !G_Impulse_NextToken%     += 1
  274. &G_Impulse_NextMethod%!0   = Flags%
  275. &G_Impulse_NextMethod%!4   = Token%
  276. !G_Impulse_NextMethod%    += 8
  277. '$G_Impulse_NextMethod%    = Method$
  278. (G_Impulse_NextMethod%    += 
  279. Method$
  280. !G_Impulse_NextMethod%?0   = 0
  281. !G_Impulse_NextMethod%    += 1
  282. '$G_Impulse_NextMethod%    = Syntax$
  283. (G_Impulse_NextMethod%    += 
  284. Syntax$
  285. !G_Impulse_NextMethod%?0   = 0
  286. !G_Impulse_NextMethod%    += 1
  287. EG_Impulse_NextMethod%     = ((G_Impulse_NextMethod% + 3) 
  288.  4) * 4
  289. shell_ImpulseWindupMethods
  290.  G_Impulse_NextMethod%!0 = -1
  291.  G_Impulse_NextMethod%!4 = -1
  292. G_Impulse_NextMethod%?8 = 0
  293. G_Impulse_NextMethod%?9 = 0
  294.  G_Impulse_NextMethod%  += 10
  295.  G_Impulse_NextMethod% > IMPULSE_METHOD_TABLE + IMPULSE_TABLE_SIZE 
  296.  200,"Impulse has run out of room in making methods" )
  297. shell_ImpulseSendCommand( Command$ )
  298.  "Impulse_SendMessage", IMPULSE_COMMAND, Command$, 0, 0, 0, 0, TASK_ID%, 0
  299. shell_ImpulseSendRequest( Request$, Tag% )
  300.  "Impulse_SendMessage", IMPULSE_REQUEST, Request$, 0, 0, 0, Tag%, TASK_ID%
  301. shell_ImpulseSendReply( Reply$, Tag% )
  302.  Size%
  303. /Size% = G_Impulse_TxTop% - G_Impulse_TxPtr%
  304.  "Impulse_SendMessage", IMPULSE_REPLY, Reply$, , , , Tag%, TASK_ID%, Size%
  305. shell_ImpulseSetupTransmission( Block%, Size% )
  306. G_Impulse_TxPtr% = Block%
  307. 7G_Impulse_TxTop% = (Block% + Size% + 4) 
  308.  &FFFFFFFC
  309. G_Impulse_TxInProgress% = 
  310. shell_ImpulseTransmitData( Allowed% )
  311.  Size%
  312. /Size% = G_Impulse_TxTop% - G_Impulse_TxPtr%
  313.  (Size% < Allowed%) 
  314.  (Size% <= 0) 
  315. "   G_Impulse_TxInProgress% = 
  316.  Size% > Allowed% 
  317.    Size% = Allowed%
  318.  Size% < 0 
  319.  Size%=0
  320.  "Impulse_TransmitData", G_Impulse_TxPtr%, Size%, 0, 0, 0, 0, TASK_ID%
  321. G_Impulse_TxPtr% += Size%
  322. shell_ImpulseInTransmission = G_Impulse_TxInProgress%
  323. Impulse_Decode( 
  324.  Reason%, 
  325.  MethodToken%, 
  326.  Params%, 
  327.  Size% )
  328.  Before%
  329. Before% = Reason%
  330.  "Impulse_Decode", Reason%, q%, , , , IMPULSE_METHOD_TABLE, TASK_ID% 
  331.  Reason%, q%, , , , MethodToken%, Params%, Size%
  332.  (Reason% = 0) 
  333.  (Before% <> 0) 
  334.    Reason% = Before%
  335. Impulse_GetString( Base%, Param%, 
  336.  Result$ )
  337. Base% = Base%!(Param% * 4)
  338.  Base% = 0 
  339. Result$ = ""
  340.  ?Base% >= 32
  341.   Result$ += 
  342. ?Base%
  343.   Base% += 1
  344. Impulse_GetValue( Base%, Param%, 
  345.  Result% )
  346. Base% = Base%!(Param% * 4)
  347.  Base% = 0 
  348. #      = 
  349.  ?Base% = 0 
  350.   Result% = Base%!1
  351. (      = 
  352.   Result% = 0
  353. +      = 
  354. Impulse_GetSwitch( Base%, Param% )
  355. = Base%!(Param% * 4) <> 0
  356. Impulse_NextTxTag
  357. G_Impulse_TxTag% += 1
  358. = G_Impulse_TxTag%
  359. Impulse_CurrentTxTag
  360. = G_Impulse_TxTag%
  361.